use strict;
use AppConfig qw(:expand :argcount);
use Digest;
use Digest::MD5;
use Date::Parse;



our (%hdr,$body,$user,@twoleveltlds,$config);


########
#
# create_article_data(): This subroutine fills $article structure with data.
#
#######


sub create_article_data()
{
	my $artdata = AppConfig->new();

# Message-ID

	$artdata->define("mid");
	$artdata->set("mid", $hdr{'Message-ID'} );
	

# Total size of all headers, in bytes

	my $headsize = 0;
	$artdata->define("headsize");
	foreach ( keys %hdr ) {
		$headsize += length($_)+length($hdr{$_})+3; # where three are ": " and \n
	}
	$artdata->set("headsize", $headsize);

# Body size

	$artdata->define("bodysize");
	$artdata->set("bodysize", length($body));

# Total size

	$artdata->define("totalsize");
        $artdata->set("totalsize", (length($body)+$artdata->headsize));

# User
	$artdata->define("user");
        $artdata->set("user", $user);

# X-Trace Stuff
# X-Trace stores Client domain (if names resolution is active (as without -N nnrpd flag), Arrival Time (UNIX time), nnrpd
# pid and client IP address

	$artdata->define("pid");
	$artdata->define("clientip");
	$artdata->define("clientdn");
	$artdata->define("arrivaltime");
	my @xtrace = split(/[\ |\t]+/, $hdr{'X-Trace'});
	$artdata->clientdn($xtrace[0]); 		# localhost.localdomain
	$artdata->arrivaltime($xtrace[1]);		# 1298817611
	$artdata->pid($xtrace[2]);			# 9910

	if ($xtrace[3] =~ /\(|\)/ ) {			# if nnrpd is executed as shell command, X-Trace is malformed by nnrpd. It's generated with only four
		$artdata->clientip("127.0.0.1");        # fields where the last is the date, usually the fifth, which starts with a "(". In this case, clientip 
	} else {					# must be set to "127.0.0.1" by hand
		$artdata->clientip($xtrace[3]);		# Usually clientip is the fourth field inside X-Trace
	}

# Number of articles in Crosspost

	$artdata->define("crosspost");
	if ( $hdr{'Newsgroups'} !~ /\,/ ) {
		$artdata->crosspost(1);   # one group must always exist
	} else {
		my @groups = split( /\,/, $hdr{'Newsgroups'});
		my $grp = @groups;
		$artdata->crosspost($grp);
	}

# Number of articles in Followup

	$artdata->define("followup");
	if ( length($hdr{'Followup-To'}) == 0 ) {	# Followup is not set
		$artdata->followup(0);			
        } elsif ( $hdr{'Followup-To'} !~ /\,/ ) {	# Followup is set to one group, no comma
                $artdata->followup(1);   
        } else {					# Followup is set to more than one group so there's a comma
                my @groups = split( /\,/, $hdr{'Followup-To'});
                my $grp = @groups;
                $artdata->followup($grp);
        }
# Knode copies Newsgroups inside followup-to so if a message was posted to a single group, followup must be set to zero
	$artdata->set("followup", 0 ) if ( ($hdr{'Newsgroups'} !~ /\,/ ) and ($hdr{'Newsgroups'} eq $hdr{'Followup-To'}));
# At the same time, if a message was posted to many groups and a single group is inserted in Followup-To, followup must
# be set to zero since poster is sending replies to only one group
	$artdata->set("followup", 0 ) if ( ($hdr{'Newsgroups'} =~ /\,/ ) and ($hdr{'Followup-To'} !~ /\,/ ));

# MD5 of body

	$artdata->define("md5body");
        my $ctx = Digest::MD5->new;
        $ctx->add($body);
        my $md5 = $ctx->b64digest;
        $artdata->md5body($md5);

# Domain

	$artdata->define("shortdn");
	my $olddom = $artdata->clientdn();
	my $dots = 1;
	foreach (@twoleveltlds) {				# detect whether current client's domain come from an official second name TLD (co.uk et similia)
		my $twolevel = $_;
		if ($olddom =~ /$twolevel/ )	{		# if so, a third element must be saved 
			&log("debug", "Parser: $olddom matches $twolevel second level domain");
			$dots = 2;
		}
	}

	my @dns = split( /\./, $olddom );
	my $num = @dns - 1;
	my $newdom;
	if ($num <= $dots) {			# if client's domain has none (localhost), one (localhost.localdomain) or two (in case of second level domains) names
		$newdom = $olddom;
		$artdata->shortdn($newdom);	# it's only needed to copy clientdn inside shortdn
	} else {				# client's domain have got more than two or three (in case of second level domains) names
		$newdom = "$dns[($num-1)].$dns[$num]" if ($dots==1);
		$newdom = "$dns[($num-2)].$dns[($num-1)].$dns[$num]" if ($dots==2);
		$artdata->shortdn("$newdom");
	}

	&log("debug", "Parser: Client's DN $olddom, Domain $newdom ($num dots, $dots to save)");

# At this point we count body lines detecting how many of them are empty, blank, quoted or well done

	my $lines 	= "0";                 # This is ugly but it's needed for a clear log
	my $quoted 	= "0";
	my $email	= "0";
	my $blank	= "0";
	my $empty	= "0";
	my $valid       = "0";
	my $longest     = "0";

	$artdata->define("lines");
	$artdata->define("quoted_lines");
	$artdata->define("longest_line");
	$artdata->define("blank_lines");
	$artdata->define("empty_lines");
	$artdata->define("welldone_lines");
	$artdata->define("email_addresses");

	while( $body =~ /\n/gi ) { $lines++; }

	my @body_strings = split( /\n/, $body );  # Body is split in an array, line per line

	foreach ( @body_strings ) {
                $quoted++    if ( $_ =~ /^[\>|\:]/ );				# Quoted lines
                $blank++     if ( $_ =~ /^[\ |\t]+$/ );				# Blank lines
		$email++     if ( $_ =~ /^\w+\@\w+\.\w+/ );			# Email addresses (mostly spam)
		$empty++     if ( length($_) == 0);				# Empty
		$valid++     if ( length($_) >  0);
		$longest = length($_) if ($longest < length($_));
        }
	
	if ($lines > ($quoted+$blank+$email+$empty+$valid)) {                  # Note: this is strange. Each time that a line
		$empty  += ($lines - ($quoted+$blank+$email+$empty+$valid));   # is empty, a null string is recorded inside
	}								       # @body_strings because split removes the marker '\n'
									       # If the null strings are at the bottom of the body
									       # they're removed by perl interpreter and so the script
									       # can't count them. They must be added again.

	my $welldone_lines = $lines - ($empty+$blank+$quoted+$email);

	&log("debug", "Parser: Total: lines $lines, well done $welldone_lines, quoted $quoted, empty $empty, blank $blank, email $email");
	
	$artdata->set("lines", $lines);
	$artdata->set("quoted_lines",$quoted);
	$artdata->set("longest_line",$longest);
	$artdata->set("blank_lines", $blank);
	$artdata->set("empty_lines", $empty);
	$artdata->set("welldone_lines", $welldone_lines);
	$artdata->set("email_addresses", $email);

	$artdata->define("quoted_ratio");
	$artdata->define("blank_ratio");
	$artdata->define("empty_ratio");
	$artdata->define("welldone_ratio");
	$artdata->define("email_ratio");

	my $quoted_ratio = "0.00";	# These lines are needed to make clear logs
	my $empty_ratio  = "0.00";
	my $blank_ratio  = "0.00";
	my $email_ratio  = "0.00";
	my $welldone_ratio = "0.00";

	$quoted_ratio = sprintf("%.2f", ($quoted / $lines)) if ($quoted>0);    # Only two digit lines make logs clearer
	$empty_ratio  = sprintf("%.2f", ($empty  / $lines)) if ($empty>0);
	$blank_ratio  = sprintf("%.2f", ($blank  / $lines)) if ($blank>0);
        $email_ratio  = sprintf("%.2f", ($email  / $lines)) if ($email>0);
	$welldone_ratio  = sprintf("%.2f", ($welldone_lines  / $lines)) if ($welldone_lines>0);

	&log("debug", "Parser: Ratio: valid $welldone_ratio, quoted $quoted_ratio, empty $empty_ratio, blank $blank_ratio, email $email_ratio");

	$artdata->set("quoted_ratio",$quoted_ratio);
	$artdata->set("blank_ratio", $blank_ratio);
	$artdata->set("empty_ratio", $empty_ratio);
	$artdata->set("welldone_ratio", $welldone_ratio);
	$artdata->set("email_ratio", $email_ratio);

	$artdata->define("is_uuencoded");
	$artdata->define("is_yenc");

# UUEncoded and yenc

	my $uuencode = &check_uuencode();
	my $yenc     = &check_yenc();

	$artdata->set("is_uuencoded", $uuencode);
	$artdata->set("is_yenc", $yenc);
	
# Date
	$artdata->define("date");
	my $client_time = str2time( $hdr{'Date'} );
	$artdata->set("date", $client_time );
	my $difftime = $xtrace[1] - $client_time;
	&log("debug", "Parser: Date $client_time, arrival time $xtrace[1], difference $difftime");

	return $artdata;


}


sub check_uuencode() {
        my @body = split(/\n/, $body );
        my $stat = 0;
        foreach ( @body ) {
               $stat = 1 if ($_ =~ /^begin\ [0-9][0-9][0-9]/i  );
               $stat = 2 if (($_ =~ /^end/i) and ( $stat == 1 ));
        }

        if ( $stat == 2 )  {
		&log("debug", "Parser: Body includes uuencoded data");
                return 1;
        }
	&log("debug", "Parser: Message doesn't include uuencoded data") if ($config->verbose() == 1);

        return (0);
}


sub check_yenc() {
        my @body = split(/\n/, $body );
        my $stat = 0;
        foreach ( @body ) {
               $stat = 1 if ($_ =~ /^\=ybegin\ /i);
               $stat = 2 if (($_ =~ /^\=yend/i) and ( $stat == 1 ));
        }

        if ( $stat == 2 ) {
		&log("debug", "Parser: Body includes yenc data");
                return 1;
        }
	&log("debug", "Parser: Message doesn't include yenc data") if ($config->verbose() == 1);
        return (0);
}

1;
